perm filename PCHK[S1,ALS]2 blob
sn#438974 filedate 1979-05-08 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (*New var's needed*)
C00006 ENDMK
Cā;
(*New var's needed*)
NWORDS_OLD : 0..MAXCODEW;
NEWINSTREC_OLD : A_CODEREC;
OPC_OLD : U_OPCODE;
OPC_OLD := OPC; (* PUT THIS IN READNXTINST AFTER begin*)
READINT (I1) ; (*THIS GOES INTO UCHKL WITH NO READINT (I2) *)
READINT (I2) ; (*THIS GOES INTO UCHKH WITH NO READINT (I1) *)
WRITEINT (I1) ; (*THIS GOES INTO UCHKL WITH NO WRITEINT (I2) *)
WRITEINT (I2) ; (*THIS GOES INTO UCHKH WITH NO WRITEINT (I1) *)
UCHKH, UCHKL :
with STK[TOP] do
begin
if OPC := UCHKH then
begin
if OPC_OLD <> UCHKL THEN I1 := 0 else
begin
NEWINSTREC := NEWINSTREC_OLD; (* To overwrite old data*)
MAINCODE.NWORDS := NWORDS_OLD;
end;
end else
begin
NEWINSTREC_OLD := NEWINSTREC;
NWORDS_OLD := MAINCODE.NWORDS;
I2 := MAXSIGNEDS1ADDR;
end;
if not ((DTYPE in [TYPA,TYPB,TYPC,TYPN])
or IS_INTEGER[DTYPE]) then
ERROR(WCHECKING_INVALID_TYPE);
if DTYPE = TYPN then
if I1 < 0 then (*nil OK*)
else ERROR(WCHECKED_CONSTANT_OUT_OF_RANGE)
else if IS_CONSTANT(TOP) then
begin
if (ADDRORVAL.FPA.MEMADR.DSPLMT < I1) then
ERROR(WCHECKED_CONSTANT_OUT_OF_RANGE)
end
else
begin (*not constant*)
GET_OPERAND(OPND2,TOP);
if TYP = TYPA then
begin (*Make sure address is on heap (or maybe nil)*)
if DTYPE <> TYPA then
ERROR(WADDRESS_CHECK_ON_NONADDRESS);
if I1 < 0 then
begin
SKIPLOC := NEWINSTREC;
IMM_OPERAND(OPND1,NILVAL);
EMITSOP(XSKP_EQL_S,0,OPND1,OPND2,nil)
end;
REG_OPERAND(OPNDR,S1RNP);
EMITXOP(XBTRP_B_S,OPNDR,OPND2);
if I1 < 0 then
FIXSOP(SKIPLOC,NEWINSTREC)
end (*TYPA*)
else
begin (*not address check*)
if (TYP=TYPJ) and ((I1=0) or (I1=1)) then
begin
(*The error trap handler will deduce that the CHK
was TYPJ by the fact that the BTRP_N was used.*)
S1OP := BTRP_N_X[I1,DTYPE];
IMM_OPERAND(OPND1,I2)
end
else
begin
S1OP := BTRP_B_X[DTYPE];
EXTENDED_REGDISP_OPERAND(OPND1,S1RPC,0);
UPD_BOUNDTBL(OPND1.XW.DISP,I1,I2,TYP);
OPND1.FIXUP := BOUNDFIX
end;
EMITXOP(S1OP,OPND1,OPND2)
end (*not address check*)
end (*not constant*)
end (*UCHK*);
UCHKF :
while STK[TOP] do
begin